home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
aijournl
/
1987_02
/
expert.feb
< prev
next >
Wrap
Text File
|
1987-01-29
|
4KB
|
98 lines
Expert's Toolbox
"Solving SFRL Problems with a Representation Language Language"
Listing 1
;; FRLL--A Frame Representation Language Language.
;; Copyright 1986 by Jonathan Amsterdam.
(DEFVAR *FRAMES* NIL) ; A list of all the frames ever created (with FPUT or
; DEFFRAME).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interface functions.
(DEFMACRO DEFFRAME (NAME &REST SLOTS-AND-VALUES)
`(PROGN
(PUSHNEW ',NAME *FRAMES*) ; PUSHNEW adds an item to a list if it
; isn't already there.
,@(LET ((RESULT NIL))
(DO ((S-AND-V SLOTS-AND-VALUES (CDDR S-AND-V)))
((NULL S-AND-V) (REVERSE RESULT))
(PUSH `(FPUT ',NAME ',(CAR S-AND-V) ',(CADR S-AND-V))
RESULT)))))
DEFMACRO DEF-RAW-FRAME (NAME &REST SLOTS-AND-VALUES)
; Need this to avoid invoking the full FGET mechanism in defining core
; frames.
`(PROGN
(PUSHNEW ',NAME *FRAMES*)
,@(LET ((RESULT NIL))
(DO ((S-AND-V SLOTS-AND-VALUES (CDDR S-AND-V)))
((NULL S-AND-V) (REVERSE RESULT))
(PUSH `(FPUT-ON-FRAME ',NAME ',(CAR S-AND-V) ,(CADR S-AND-V))
RESULT)))))
(DEFUN FGET (FRAME SLOT)
(OR (FGET-ON-FRAME FRAME SLOT)
(FUNCALL (FGET SLOT 'GET-VALUE) FRAME SLOT)))
DEFUN FPUT (FRAME SLOT VALUES)
(LET ((FUNCTION (FGET SLOT 'PUT-VALUE)))
(IF FUNCTION
FUNCALL FUNCTION FRAME SLOT VALUES)
(FPUT-ON-FRAME FRAME SLOT VALUES))))
(DEFUN FGET-ON-FRAME (FRAME SLOT)
(CDR (ASSOC SLOT (GET FRAME 'FRAME))))
(DEFUN FPUT-ON-FRAME (FRAME SLOT VAL)
(LET ((FRAME-LIST (GET FRAME 'FRAME)))
(LET ((OLD-SLOT (ASSOC SLOT FRAME-LIST)))
(IF OLD-SLOT
(RPLACD OLD-SLOT VAL)
(PUSHNEW FRAME *FRAMES*)
(SETF (GET FRAME 'FRAME) (CONS (CONS SLOT VAL) FRAME-LIST))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions which live in the initial network
(DEFUN GET-VALUE-FUNCTION (FRAME SLOT)
(N-INHERITANCE FRAME SLOT (FGET SLOT 'INHERITS-THROUGH)))è(DEFUN N-INHERITANCE (FRAME SLOT PATH-SLOT)
;; Returns the first value found, along PATH-SLOT, using N pattern.
(OR (FGET-ON-FRAME FRAME SLOT)
(DOLIST (PARENT (LISTIFY (FGET FRAME PATH-SLOT)))
(LET ((RESULT (N-INHERITANCE PARENT SLOT PATH-SLOT)))
(IF RESULT (RETURN RESULT))))))
(DEFUN LISTIFY (X)
(IF (NOT (LISTP X)) (LIST X)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basic core of network.
(DEF-RAW-FRAME FRAME
AKO 'FRAME)
(DEF-RAW-FRAME SLOT
AKO 'FRAME
GET-VALUE 'FGET-ON-FRAME
PUT-VALUE 'FPUT-ON-FRAME)
DEF-RAW-FRAME N-INHERITANCE-SLOT
SLOT-TYPE 'SLOT
GET-VALUE 'GET-VALUE-FUNCTION)
DEF-RAW-FRAME GET-VALUE
SLOT-TYPE 'N-INHERITANCE-SLOT
;; Set GET-VALUE's GET-VALUE slot explicitly to make it all work.!
..
GET-VALUE 'GET-VALUE-FUNCTION
INHERITS-THROUGH 'SLOT-TYPE)
(DEF-RAW-FRAME PUT-VALUE
SLOT-TYPE 'N-INHERITANCE-SLOT
INHERITS-THROUGH 'SLOT-TYPE)
(DEF-RAW-FRAME SLOT-TYPE
SLOT-TYPE 'SLOT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Network used in example
(DEFFRAME CUISINE
SLOT-TYPE N-INHERITANCE-SLOT
INHERITS-THROUGH RESTAURANT-TYPE)
(DEFFRAME CHINESE-RESTAURANT
CUISINE CHINESE)
(DEFFRAME MARY-CHUNGS
RESTAURANT-TYPE CHINESE-RESTAURANT)
;;; End of file.